home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / mac / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectPlay / DXVBMessenger / Server / modDPlayServer.bas < prev    next >
BASIC Source File  |  2001-10-08  |  3KB  |  82 lines
  1. Attribute VB_Name = "modDPlayServer"
  2. Option Explicit
  3. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  4. '
  5. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  6. '
  7. '  File:       modDPlayServer.bas
  8. '
  9. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  10.  
  11. 'Public vars for the app
  12. Public dx As New DirectX8
  13. Public dps As DirectPlay8Server
  14. Public dpa As DirectPlay8Address
  15. Public glNumPlayers As Long
  16.  
  17. Public Sub Main()
  18.     If App.PrevInstance Then
  19.         MsgBox "You can only run one instance of this server at a time.", vbOKOnly Or vbInformation, "Close other instance"
  20.         Exit Sub
  21.     End If
  22.     'Set up the default DPlay objects
  23.     InitDPlay
  24.     'Show the form (which will start the server)
  25.     frmServer.Show
  26. End Sub
  27.  
  28. Public Sub InitDPlay()
  29.  
  30.     Set dps = dx.DirectPlayServerCreate
  31.     Set dpa = dx.DirectPlayAddressCreate
  32.     
  33. End Sub
  34.  
  35. Public Sub Cleanup()
  36.  
  37.     'Shut down our message handler
  38.     If Not dps Is Nothing Then dps.UnRegisterMessageHandler
  39.     'Close down our session
  40.     If Not dps Is Nothing Then dps.Close
  41.     Set dps = Nothing
  42.     Set dpa = Nothing
  43.     Set dx = Nothing
  44.     
  45. End Sub
  46.  
  47. 'Send a message to a player
  48. Public Function SendMessage(ByVal sUser As String, ByVal sFrom As String, ByVal sChat As String) As Boolean
  49.  
  50.     Dim lSendID As Long, lMsg As Long
  51.     Dim oBuf() As Byte, lOffset As Long
  52.     
  53.     'Before we send this message check to see if this user is blocked
  54.     If AmIBlocked(sUser, sFrom) Then
  55.         lSendID = GetCurrentDPlayID(sFrom)
  56.         lMsg = Msg_UserBlocked
  57.         lOffset = NewBuffer(oBuf)
  58.         AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  59.         AddStringToBuffer oBuf, sUser, lOffset
  60.         dps.SendTo lSendID, oBuf, 0, 0
  61.     Else
  62.         lSendID = GetCurrentDPlayID(sUser)
  63.         If lSendID = 0 Then 'This person isn't logged on
  64.             lSendID = GetCurrentDPlayID(sFrom)
  65.             lMsg = Msg_UserUnavailable
  66.             lOffset = NewBuffer(oBuf)
  67.             AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  68.             AddStringToBuffer oBuf, sUser, lOffset
  69.             AddStringToBuffer oBuf, sChat, lOffset
  70.         Else
  71.             lMsg = Msg_ReceiveMessage
  72.             lOffset = NewBuffer(oBuf)
  73.             AddDataToBuffer oBuf, lMsg, LenB(lMsg), lOffset
  74.             AddStringToBuffer oBuf, sFrom, lOffset
  75.             AddStringToBuffer oBuf, sChat, lOffset
  76.         End If
  77.         dps.SendTo lSendID, oBuf, 0, 0
  78.     End If
  79.     SendMessage = True
  80.  
  81. End Function
  82.